perm filename PIX.SAI[PIX,HPM]1 blob sn#011189 filedate 1972-11-12 generic text, type T, neo UTF8
01200	BEGIN "PIX"
01300	
01400	REQUIRE "HELIB[1,3]" LIBRARY;
01500	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
01600	REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
01700	REQUIRE 2000 STRING_SPACE;
01800	REQUIRE "⊂⊃||" DELIMITERS;
01900	
02000	DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
02100		CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
02200		RED=⊂2⊃, BLUE=⊂3⊃, GREEN=⊂4⊃, CLEAR=⊂1⊃, XDATA=⊂3⊃;
02300	EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INT ARRAY STOR);
02400	EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
02500	EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
02600	EXT PRO RELCOR(INT IOWD);
02700	EXT INT PRO GETCOR(INT SIZE);
02800	EXT BOOLEAN PRO VIDEO(INT EXP, X,Y);
02900	EXT PRO INP;
03000	EXT INT PRO GIOWD(INT ARRAY BUF);
03100	EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
03200	EXT PRO CWHEEL(INT CODE);
03300	EXT PRO TVIN;
03400	EXT PRO PRDUMP;
03500	EXT PRO PORTR;
03600	FORTRAN REAL PROCEDURE SIN;
03700	FORTRAN REAL PROCEDURE COS;
03800	FORTRAN REAL PROCEDURE SQRT(REAL X);
03900	EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
04000	EXTERNAL PROCEDURE CALLEN;
04100	EXTERNAL PROCEDURE SPWOFF;
04200	EXT PROCEDURE INVRT(REAL ARRAY A,AI);
04300	
04400	EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
04500		L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS,TVCAM;
04600	
04700	SAFE INT ARRAY PNTRS[1:25], DPYBUF[1:600], CLIPS[1:4,1:3];
04800	SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
04900		MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
05000	INT I, EXP, ANS, FSAV, LLSAV, RSAV, LSAV, TVLENG, PICNUM, CAMERR;
05100	REAL PANPOT, FOCPOT, TILPOT;
05200	LABEL LOOP, SKIP, SKIP1;
05300	BOOLEAN SENSSET, TVREAD;
05400	STRING STR, TITLE, DESCRIPT;
05500	SAFE INTEGER ARRAY PICALLOC[1:25];  α  allocation table for data blocks;
05600	PRELOAD_WITH 3,0,1,2;
05700	SAFE INT ARRAY COLNUM[1:4];
05800	α	first we initialize the world;
05900		CALL('15,"VDSMAP");
06000		TVCAM ← 3;
06100		TCLIP ← 0;
06200		BCLIP ← 7;
06300		SENSSET ← EXP ← FALSE;
06400		CLIPS[1,1] ← -1;
06500		ARRBLT(CLIPS[1,2],CLIPS[1,1],11);
06600		PICALLOC[1] ← PNTRS[1] ← 0;
06700		ARRBLT(PICALLOC[2],PICALLOC[1],24);
06800		ARRBLT(PNTRS[2],PNTRS[1],24);
06900		LOOP:	BEGIN "TVIN"
07000				BEGIN INTEGER ARRAY BUF[1:10000];
07100				TVWORD ← GIOWD(BUF);
07200				FLINE←'13;
07300				LLINE←'373;
07400				RSIDE←'512;
07500				LSIDE←'13;
07600				FSAV ← FLINE;
07700				LLSAV ← LLINE;
07800				RSAV ← RSIDE;
07900				LSAV ← LSIDE;
08000				END;
08100			TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
08200			DESCRIPT ← TITLE ←NULL;
08300			PICALLOC[CLEAR] ← GETCOR(TVLENG);
08400	SKIP1:		FOR I←1 STEP 1 UNTIL 4 DO IF CLIPS[I,1]<0 THEN
08500				BEGIN CLIPS[I,1] ← BCLIP; CLIPS[I,2] ← TCLIP;END;
08600	α		and, finally, take the picture;
08700	
08800			FLINE ← FSAV;
08900			LLINE ← LLSAV;
09000			RSIDE ← RSAV;
09100			LSIDE ← LSAV;
09200			FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
09300				BEGIN "TAKE" INTEGER N;
09400				TVWORD ← PICALLOC[I];
09500				BCLIP ← CLIPS[I,1];
09600				TCLIP ← CLIPS[I,2];
09700				INCHRW;
09800				TVIN;
09900				END "TAKE";
10000			END "TVIN";
10100			BEGIN "DSKOUT"
10200			INTEGER FILE, PPN, EXTEN, FAIL;
10300			LABEL LOOP3;
10400			FOR I←1 STEP 1 UNTIL 25 DO PNTRS[I]←
10500				IF PICALLOC[I] THEN PICALLOC[I]+1 ELSE 0;
10600	LOOP3:		OUTSTR("FILE NAME=");
10700			FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
10800			IF LENGTH(STR)≠0 THEN
10900			BEGIN
11000			PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
11100			IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "&STR&" FAILED"); GO TO LOOP3;END;
11200			OUTSTR("FILE "&STR&" WRITTEN OUT"&CRLF);
11300			END;
11400			END "DSKOUT";
11500	α	return for next picture;
11600	
11700		FOR I←1 STEP 1 UNTIL 25 DO
11800	                BEGIN
11900			IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
12000			PICALLOC[I] ← PNTRS[I] ← 0;
12100			END;
12200			GO TO LOOP;
12300	END;